perm filename BENCH[TIM,LSP] blob
sn#756851 filedate 1984-05-17 generic text, type T, neo UTF8
;;; How to run things:
;;;
;;; TAK: (TAK 18 12 6)
;;; CTAK: (TAK 18 12 6)
;;; cTAK: (TAK 18 12 6)
;;; TAKL: (TAK 18L 12L 6L)
;;; TAKR: (TAK0 18 12 6)
;;; FRPOLY: Do this: (SETUP); time these (BENCH 2)(BENCH 5)(BENCH 10)(BENCH 15)
;;; PUZZLE: (START)
;;; DERIV: (RUN)
;;; DDERIV: (RUN)
;;; FDDERIV: (RUN)
;;; FFT: Time this:
;;; (DO ((NTIMES 0 (1+ NTIMES)))
;;; ((= NTIMES 10.))
;;; (FFT 'RE 'IM)))
;;; BROWSE: (BROWSE)
;;; TRAVERSE: Time these:
;;; (PROG2 (SETQ ROOT (CREATE-STRUCTURE 100.)) ()))
;;; (DO ((I 50. (1- I)))
;;; ((= I 0))
;;; (TRAVERSE ROOT)
;;; (TRAVERSE ROOT)
;;; (TRAVERSE ROOT)
;;; (TRAVERSE ROOT)
;;; (TRAVERSE ROOT)))
;;; DIV2: Time these:
;;; (TEST1 L)
;;; (TEST2 L)
;;; FPRINT: (FPRINT)
;;; FPREAD: (FREAD)
;;; TPRINT: Time this: (PRINT TEST-PATTERN)
;;; DESTRUCTIVE: (DESTRUCTIVE 600 50)
;;; TRIANG: (GOGOGO 22.)
;;; BOYER: Time these:
;;; (SETUP)
;;; (TEST)
;;; Calls to TIMER make up a function that does the timing. The code
;;; is included below. The form is (timer timit form)
;;; timit is the function that is defined and form is what to time.
;;; This will tell you what to time for each benchmark. They are
;;; separated by begin-end pairs.
;;;BEGIN
;;;BEGIN
;;;TAK
(declare
(fixnum (tak fixnum fixnum fixnum)))
(defun tak (x y z)
(cond ((not (< y x)) ;x≤y
z)
(t (tak (tak (1- x) y z)
(tak (
- y) z x)
(tak (1- z) x y)))))
(include "timer.lsp")
(timer timit
(tak 18. 12. 6.))
(timer nc-timit (tak 10018. 10012. 10006.))
;;;END
;;;BEGIN
;;;FRPOLY
;;; Franz Lisp benchmark from Fateman
;; test from Berkeley based on polynomial arithmetic.
(declare (special ans coef f inc i k qq ss v *x*
*alpha *a* *b* *chk *l *p q* u* *var *y*
r r2 r3 start res1 res2 res3))
;(declare (localf pcoefadd pcplus pcplus1 pplus ptimes ptimes1
; ptimes2 ptimes3 psimp pctimes pctimes1
; pplus1))
;; Franz uses maclisp hackery here; you can rewrite lots of ways.
(defmacro pointergp (x y) `(> (get ,x 'order)(get ,y 'order)))
(defmacro pcoefp (e) `(atom ,e))
(defmacro pzerop (x) `(signp e ,x)) ;true for 0 or 0.0
(defmacro pzero () 0)
(defmacro cplus (x y) `(plus ,x ,y))
(defmacro ctimes (x y) `(times ,x ,y))
(defun pcoefadd (e c x) (cond ((pzerop c) x)
(t (cons e (cons c x)))))
(defun pcplus (c p) (cond ((pcoefp p) (cplus p c))
(t (psimp (car p) (pcplus1 c (cdr p))))))
(defun pcplus1 (c x)
(cond ((null x)
(cond ((pzerop c) nil) (t (cons 0 (cons c nil)))))
((pzerop (car x)) (pcoefadd 0 (pplus c (cadr x)) nil))
(t (cons (car x) (cons (cadr x) (pcplus1 c (cddr x)))))))
(defun pctimes (c p) (cond ((pcoefp p) (ctimes c p))
(t (psimp (car p) (pctimes1 c (cdr p))))))
(defun pctimes1 (c x)
(cond ((null x) nil)
(t (pcoefadd (car x)
(ptimes c (cadr x))
(pctimes1 c (cddr x))))))
(defun pplus (x y) (cond ((pcoefp x) (pcplus x y))
((pcoefp y) (pcplus y x))
((eq (car x) (car y))
(psimp (car x) (pplus1 (cdr y) (cdr x))))
((pointergp (car x) (car y))
(psimp (car x) (pcplus1 y (cdr x))))
(t (psimp (car y) (pcplus1 x (cdr y))))))
(defun pplus1 (x y)
(cond ((null x) y)
((null y) x)
((= (car x) (car y))
(pcoefadd (car x)
(pplus (cadr x) (cadr y))
(pplus1 (cddr x) (cddr y))))
((> (car x) (car y))
(cons (car x) (cons (cadr x) (pplus1 (cddr x) y))))
(t (cons (car y) (cons (cadr y) (pplus1 x (cddr y)))))))
(defun psimp (var x)
(cond ((null x) 0)
((atom x) x)
((zerop (car x)) (cadr x))
(t (cons var x))))
(defun ptimes (x y) (cond ((or (pzerop x) (pzerop y)) (pzero))
((pcoefp x) (pctimes x y))
((pcoefp y) (pctimes y x))
((eq (car x) (car y))
(psimp (car x) (ptimes1 (cdr x) (cdr y))))
((pointergp (car x) (car y))
(psimp (car x) (pctimes1 y (cdr x))))
(t (psimp (car y) (pctimes1 x (cdr y))))))
(defun ptimes1 (*x* y) (prog (u* v)
(setq v (setq u* (ptimes2 y)))
a (setq *x* (cddr *x*))
(cond ((null *x*) (return u*)))
(ptimes3 y)
(go a)))
(defun ptimes2 (y) (cond ((null y) nil)
(t (pcoefadd (plus (car *x*) (car y))
(ptimes (cadr *x*) (cadr y))
(ptimes2 (cddr y))))))
(defun ptimes3 (y)
(prog (e u c)
a1 (cond ((null y) (return nil)))
(setq e (+ (car *x*) (car y)))
(setq c (ptimes (cadr y) (cadr *x*) ))
(cond ((pzerop c) (setq y (cddr y)) (go a1))
((or (null v) (> e (car v)))
(setq u* (setq v (pplus1 u* (list e c))))
(setq y (cddr y)) (go a1))
((= e (car v))
(setq c (pplus c (cadr v)))
(cond ((pzerop c) (setq u* (setq v (pdiffer1 u* (list (car v) (cadr v))))))
(t (rplaca (cdr v) c)))
(setq y (cddr y))
(go a1)))
a (cond ((and (cddr v) (> (caddr v) e)) (setq v (cddr v)) (go a)))
(setq u (cdr v))
b (cond ((or (null (cdr u)) (< (cadr u) e))
(rplacd u (cons e (cons c (cdr u)))) (go e)))
(cond ((pzerop (setq c (pplus (caddr u) c))) (rplacd u (cdddr u)) (go d))
(t (rplaca (cddr u) c)))
e (setq u (cddr u))
d (setq y (cddr y))
(cond ((null y) (return nil)))
(setq e (+ (car *x*) (car y)))
(setq c (ptimes (cadr y) (cadr *x*)))
c (cond ((and (cdr u) (> (cadr u) e)) (setq u (cddr u)) (go c)))
(go b)))
(defun pexptsq (p n)
(do ((n (quotient n 2) (quotient n 2))
(s (cond ((oddp n) p) (t 1))))
((zerop n) s)
(setq p (ptimes p p))
(and (oddp n) (setq s (ptimes s p))) ))
(defun setup nil
(putprop 'x 1 'order)
(putprop 'y 2 'order)
(putprop 'z 3 'order)
(setq r (pplus '(x 1 1 0 1) (pplus '(y 1 1) '(z 1 1)))) ; r= x+y+z+1
(setq r2 (ptimes r 100000)) ;r2 = 100000*r
(setq r3 (ptimes r 1.0)); r3 = r with floating point coefficients
)
; time various computations of powers of polynomials, not counting
;printing but including gc time ; provide account of g.c. time.
(include "timer.lsp")
(timer timit1
(pexptsq r n) n)
(timer timit2
(pexptsq r2 n) n)
(timer timit3
(pexptsq r3 n) n)
(defun bench (n)
(print 'test1)
(timit1 n)
(print 'test2)
(timit2 n)
(print 'test3)(timit3 n))
(setup)
; then (bench 2) ; this should be pretty fast.
; then (bench 5)
; then (bench 10)
; then (bench 15)
;...
;;;END
;;;BEGIN
;;;TAKL
(defun listn (n)
(cond
((= 0 n)
nil)
(t (cons n (listn (1- n))))))
(defun mas (x y z)
(cond
((not (shorterp y x))
z)
(t (mas (mas (cdr x)
y z)
(mas (cdr y)
z x)
(mas (cdr z)
x y)))))
(defun shorterp (x y)
(and y (or (null x)
(shorterp (cdr x)
(cdr y)))))
;benchmark is called
;(mas (listn 18) (listn 12) (listn 6))
(include "timer.lsp")
(declare (special 18l 12l 6l))
(setq 18l (listn 18.)
12l (listn 12.)
6l (listn 6.))
(timer timit
(mas 18l 12l 6l))
;;;END
;;;BEGIN
;;;TAKR
;;; Gross MacLisp Version
(include "timer.lsp")
(timer timit
(tak0 18. 12. 6.))
(DECLARE (FIXNUM (TAK0 FIXNUM FIXNUM FIXNUM)
(TAK1 FIXNUM FIXNUM FIXNUM)
(TAK2 FIXNUM FIXNUM FIXNUM)
(TAK3 FIXNUM FIXNUM FIXNUM)
(TAK4 FIXNUM FIXNUM FIXNUM)
(TAK5 FIXNUM FIXNUM FIXNUM)
(TAK6 FIXNUM FIXNUM FIXNUM)
(TAK7 FIXNUM FIXNUM FIXNUM)
(TAK8 FIXNUM FIXNUM FIXNUM)
(TAK9 FIXNUM FIXNUM FIXNUM)
(TAK10 FIXNUM FIXNUM FIXNUM)
(TAK11 FIXNUM FIXNUM FIXNUM)
(TAK12 FIXNUM FIXNUM FIXNUM)
(TAK13 FIXNUM FIXNUM FIXNUM)
(TAK14 FIXNUM FIXNUM FIXNUM)
(TAK15 FIXNUM FIXNUM FIXNUM)
(TAK16 FIXNUM FIXNUM FIXNUM)
(TAK17 FIXNUM FIXNUM FIXNUM)
(TAK18 FIXNUM FIXNUM FIXNUM)
(TAK19 FIXNUM FIXNUM FIXNUM)
(TAK20 FIXNUM FIXNUM FIXNUM)
(TAK21 FIXNUM FIXNUM FIXNUM)
(TAK22 FIXNUM FIXNUM FIXNUM)
(TAK23 FIXNUM FIXNUM FIXNUM)
(TAK24 FIXNUM FIXNUM FIXNUM)
(TAK25 FIXNUM FIXNUM FIXNUM)
(TAK26 FIXNUM FIXNUM FIXNUM)
(TAK27 FIXNUM FIXNUM FIXNUM)
(TAK28 FIXNUM FIXNUM FIXNUM)
(TAK29 FIXNUM FIXNUM FIXNUM)
(TAK30 FIXNUM FIXNUM FIXNUM)
(TAK31 FIXNUM FIXNUM FIXNUM)
(TAK32 FIXNUM FIXNUM FIXNUM)
(TAK33 FIXNUM FIXNUM FIXNUM)
(TAK34 FIXNUM FIXNUM FIXNUM)
(TAK35 FIXNUM FIXNUM FIXNUM)
(TAK36 FIXNUM FIXNUM FIXNUM)
(TAK37 FIXNUM FIXNUM FIXNUM)
(TAK38 FIXNUM FIXNUM FIXNUM)
(TAK39 FIXNUM FIXNUM FIXNUM)
(TAK40 FIXNUM FIXNUM FIXNUM)
(TAK41 FIXNUM FIXNUM FIXNUM)
(TAK42 FIXNUM FIXNUM FIXNUM)
(TAK43 FIXNUM FIXNUM FIXNUM)
(TAK44 FIXNUM FIXNUM FIXNUM)
(TAK45 FIXNUM FIXNUM FIXNUM)
(TAK46 FIXNUM FIXNUM FIXNUM)
(TAK47 FIXNUM FIXNUM FIXNUM)
(TAK48 FIXNUM FIXNUM FIXNUM)
(TAK49 FIXNUM FIXNUM FIXNUM)
(TAK50 FIXNUM FIXNUM FIXNUM)
(TAK51 FIXNUM FIXNUM FIXNUM)
(TAK52 FIXNUM FIXNUM FIXNUM)
(TAK53 FIXNUM FIXNUM FIXNUM)
(TAK54 FIXNUM FIXNUM FIXNUM)
(TAK55 FIXNUM FIXNUM FIXNUM)
(TAK56 FIXNUM FIXNUM FIXNUM)
(TAK57 FIXNUM FIXNUM FIXNUM)
(TAK58 FIXNUM FIXNUM FIXNUM)
(TAK59 FIXNUM FIXNUM FIXNUM)
(TAK60 FIXNUM FIXNUM FIXNUM)
(TAK61 FIXNUM FIXNUM FIXNUM)
(TAK62 FIXNUM FIXNUM FIXNUM)
(TAK63 FIXNUM FIXNUM FIXNUM)
(TAK64 FIXNUM FIXNUM FIXNUM)
(TAK65 FIXNUM FIXNUM FIXNUM)
(TAK66 FIXNUM FIXNUM FIXNUM)
(TAK67 FIXNUM FIXNUM FIXNUM)
(TAK68 FIXNUM FIXNUM FIXNUM)
(TAK69 FIXNUM FIXNUM FIXNUM)
(TAK70 FIXNUM FIXNUM FIXNUM)
(TAK71 FIXNUM FIXNUM FIXNUM)
(TAK72 FIXNUM FIXNUM FIXNUM)
(TAK73 FIXNUM FIXNUM FIXNUM)
(TAK74 FIXNUM FIXNUM FIXNUM)
(TAK75 FIXNUM FIXNUM FIXNUM)
(TAK76 FIXNUM FIXNUM FIXNUM)
(TAK77 FIXNUM FIXNUM FIXNUM)
(TAK78 FIXNUM FIXNUM FIXNUM)
(TAK79 FIXNUM FIXNUM FIXNUM)
(TAK80 FIXNUM FIXNUM FIXNUM)
(TAK81 FIXNUM FIXNUM FIXNUM)
(TAK82 FIXNUM FIXNUM FIXNUM)
(TAK83 FIXNUM FIXNUM FIXNUM)
(TAK84 FIXNUM FIXNUM FIXNUM)
(TAK85 FIXNUM FIXNUM FIXNUM)
(TAK86 FIXNUM FIXNUM FIXNUM)
(TAK87 FIXNUM FIXNUM FIXNUM)
(TAK88 FIXNUM FIXNUM FIXNUM)
(TAK89 FIXNUM FIXNUM FIXNUM)
(TAK90 FIXNUM FIXNUM FIXNUM)
(TAK91 FIXNUM FIXNUM FIXNUM)
(TAK92 FIXNUM FIXNUM FIXNUM)
(TAK93 FIXNUM FIXNUM FIXNUM)
(TAK94 FIXNUM FIXNUM FIXNUM)
(TAK95 FIXNUM FIXNUM FIXNUM)
(TAK96 FIXNUM FIXNUM FIXNUM)
(TAK97 FIXNUM FIXNUM FIXNUM)
(TAK98 FIXNUM FIXNUM FIXNUM)
(TAK99 FIXNUM FIXNUM FIXNUM)))
(DEFUN TAK0 (X Y Z)
(COND ((NOT (< Y X)) Z)
(T (TAK1 (TAK37 (1- X) Y Z)
(TAK11 (1- Y) Z X)
(TAK17 (1- Z) X Y)))))
(DEFUN TAK1 (X Y Z)
(COND ((NOT (< Y X)) Z)
(T (TAK2 (TAK74 (1- X) Y Z)
(TAK22 (1- Y) Z X)
(TAK34 (1- Z) X Y)))))
(DEFUN TAK2 (X Y Z)
(COND ((NOT (< Y X)) Z)
(T (TAK3 (TAK11 (1- X) Y Z)
(TAK33 (1- Y) Z X)
(TAK51 (1- Z) X Y)))))
(DEFUN TAK3 (X Y Z)
(COND ((NOT (< Y X)) Z)
(T (TAK4 (TAK48 (1- X) Y Z)
(TAK44 (1- Y) Z X)
(TAK68 (1- Z) X Y)))))
(DEFUN TAK4 (X Y Z)
(COND ((NOT (< Y X)) Z)
(T (TAK5 (TAK85 (1- X) Y Z)
(TAK55 (1- Y) Z X)
(TAK85 (1- Z) X Y)))))
(DEFUN TAK5 (X Y Z)
(COND ((NOT (< Y X)) Z)
(T (TAK6 (TAK22 (1- X) Y Z)
(TAK66 (1- Y) Z X)
(TAK2 (1- Z) X Y)))))
(DEFUN TAK6 (X Y Z)
(COND ((NOT (< Y X)) Z)
(T (TAK7 (TAK59 (1- X) Y Z)
(TAK77 (1- Y) Z X)
(TAK19 (1- Z) X Y)))))
(DEFUN TAK7 (X Y Z)
(COND ((NOT (< Y X)) Z)
(T (TAK8 (TAK96 (1- X) Y Z)
(TAK88 (1- Y) Z X)
(TAK36 (1- Z) X Y)))))
(DEFUN TAK8 (X Y Z)
(COND ((NOT (< Y X)) Z)
(T (TAK9 (TAK33 (1- X) Y Z)
(TAK99 (1- Y) Z X)
(TAK53 (1- Z) X Y)))))
(DEFUN TAK9 (X Y Z)
(COND ((NOT (< Y X)) Z)
(T (TAK10 (TAK70 (1- X) Y Z)
(TAK10 (1- Y) Z X)
(TAK70 (1- Z) X Y)))))
(DEFUN TAK10 (X Y Z)
(COND ((NOT (< Y X)) Z)
(T (TAK11 (TAK7 (1- X) Y Z)
(TAK21 (1- Y) Z X)
(TAK87 (1- Z) X Y)))))
(DEFUN TAK11 (X Y Z)
(COND ((NOT (< Y X)) Z)
(T (TAK12 (TAK44 (1- X) Y Z)
(TAK32 (1- Y) Z X)
(TAK4 (1- Z) X Y)))))
(DEFUN TAK12 (X Y Z)
(COND ((NOT (< Y X)) Z)
(T (TAK13 (TAK81 (1- X) Y Z)
(TAK43 (1- Y) Z X)
(TAK21 (1- Z) X Y)))))
(DEFUN TAK13 (X Y Z)
(COND ((NOT (< Y X)) Z)
(T (TAK14 (TAK18 (1- X) Y Z)
(TAK54 (1- Y) Z X)
(TAK38 (1- Z) X Y)))))
(DEFUN TAK14 (X Y Z)
(COND ((NOT (< Y X)) Z)
(T (TAK15 (TAK55 (1- X) Y Z)
(TAK65 (1- Y) Z X)
(TAK55 (1- Z) X Y)))))
(DEFUN TAK15 (X Y Z)
(COND ((NOT (< Y X)) Z)
(T (TAK16 (TAK92 (1- X) Y Z)
(TAK76 (1- Y) Z X)
(TAK72 (1- Z) X Y)))))
(DEFUN TAK16 (X Y Z)
(COND ((NOT (< Y X)) Z)
(T (TAK17 (TAK29 (1- X) Y Z)
(TAK87 (1- Y) Z X)
(TAK89 (1- Z) X Y)))))
(DEFUN TAK17 (X Y Z)
(COND ((NOT (< Y X)) Z)
(T (TAK18 (TAK66 (1- X) Y Z)
(TAK98 (1- Y) Z X)
(TAK6 (1- Z) X Y)))))
(DEFUN TAK18 (X Y Z)
(COND ((NOT (< Y X)) Z)
(T (TAK19 (TAK3 (1- X) Y Z)
(TAK9 (1- Y) Z X)
(TAK23 (1- Z) X Y)))))
(DEFUN TAK19 (X Y Z)
(COND ((NOT (< Y X)) Z)
(T (TAK20 (TAK40 (1- X) Y Z)
(TAK20 (1- Y) Z X)
(TAK40 (1- Z) X Y)))))
(DEFUN TAK20 (X Y Z)
(COND ((NOT (< Y X)) Z)
(T (TAK21 (TAK77 (1- X) Y Z)
(TAK31 (1- Y) Z X)
(TAK57 (1- Z) X Y)))))
(DEFUN TAK21 (X Y Z)
(COND ((NOT (< Y X)) Z)
(T (TAK22 (TAK14 (1- X) Y Z)
(TAK42 (1- Y) Z X)
(TAK74 (1- Z) X Y)))))
(DEFUN TAK22 (X Y Z)
(COND ((NOT (< Y X)) Z)
(T (TAK23 (TAK51 (1- X) Y Z)
(TAK53 (1- Y) Z X)
(TAK91 (1- Z) X Y)))))
(DEFUN TAK23 (X Y Z)
(COND ((NOT (< Y X)) Z)
(T (TAK24 (TAK88 (1- X) Y Z)
(TAK64 (1- Y) Z X)
(TAK8 (1- Z) X Y)))))
(DEFUN TAK24 (X Y Z)
(COND ((NOT (< Y X)) Z)
(T (TAK25 (TAK25 (1- X) Y Z)
(TAK75 (1- Y) Z X)
(TAK25 (1- Z) X Y)))))
(DEFUN TAK25 (X Y Z)
(COND ((NOT (< Y X)) Z)
(T (TAK26 (TAK62 (1- X) Y Z)
(TAK86 (1- Y) Z X)
(TAK42 (1- Z) X Y)))))
(DEFUN TAK26 (X Y Z)
(COND ((NOT (< Y X)) Z)
(T (TAK27 (TAK99 (1- X) Y Z)
(TAK97 (1- Y) Z X)
(TAK59 (1- Z) X Y)))))
(DEFUN TAK27 (X Y Z)
(COND ((NOT (< Y X)) Z)
(T (TAK28 (TAK36 (1- X) Y Z)
(TAK8 (1- Y) Z X)
(TAK76 (1- Z) X Y)))))
(DEFUN TAK28 (X Y Z)
(COND ((NOT (< Y X)) Z)
(T (TAK29 (TAK73 (1- X) Y Z)
(TAK19 (1- Y) Z X)
(TAK93 (1- Z) X Y)))))
(DEFUN TAK29 (X Y Z)
(COND ((NOT (< Y X)) Z)
(T (TAK30 (TAK10 (1- X) Y Z)
(TAK30 (1- Y) Z X)
(TAK10 (1- Z) X Y)))))
(DEFUN TAK30 (X Y Z)
(COND ((NOT (< Y X)) Z)
(T (TAK31 (TAK47 (1- X) Y Z)
(TAK41 (1- Y) Z X)
(TAK27 (1- Z) X Y)))))
(DEFUN TAK31 (X Y Z)
(COND ((NOT (< Y X)) Z)
(T (TAK32 (TAK84 (1- X) Y Z)
(TAK52 (1- Y) Z X)
(TAK44 (1- Z) X Y)))))
(DEFUN TAK32 (X Y Z)
(COND ((NOT (< Y X)) Z)
(T (TAK33 (TAK21 (1- X) Y Z)
(TAK63 (1- Y) Z X)
(TAK61 (1- Z) X Y)))))
(DEFUN TAK33 (X Y Z)
(COND ((NOT (< Y X)) Z)
(T (TAK34 (TAK58 (1- X) Y Z)
(TAK74 (1- Y) Z X)
(TAK78 (1- Z) X Y)))))
(DEFUN TAK34 (X Y Z)
(COND ((NOT (< Y X)) Z)
(T (TAK35 (TAK95 (1- X) Y Z)
(TAK85 (1- Y) Z X)
(TAK95 (1- Z) X Y)))))
(DEFUN TAK35 (X Y Z)
(COND ((NOT (< Y X)) Z)
(T (TAK36 (TAK32 (1- X) Y Z)
(TAK96 (1- Y) Z X)
(TAK12 (1- Z) X Y)))))
(DEFUN TAK36 (X Y Z)
(COND ((NOT (< Y X)) Z)
(T (TAK37 (TAK69 (1- X) Y Z)
(TAK7 (1- Y) Z X)
(TAK29 (1- Z) X Y)))))
(DEFUN TAK37 (X Y Z)
(COND ((NOT (< Y X)) Z)
(T (TAK38 (TAK6 (1- X) Y Z)
(TAK18 (1- Y) Z X)
(TAK46 (1- Z) X Y)))))
(DEFUN TAK38 (X Y Z)
(COND ((NOT (< Y X)) Z)
(T (TAK39 (TAK43 (1- X) Y Z)
(TAK29 (1- Y) Z X)
(TAK63 (1- Z) X Y)))))
(DEFUN TAK39 (X Y Z)
(COND ((NOT (< Y X)) Z)
(T (TAK40 (TAK80 (1- X) Y Z)
(TAK40 (1- Y) Z X)
(TAK80 (1- Z) X Y)))))
(DEFUN TAK40 (X Y Z)
(COND ((NOT (< Y X)) Z)
(T (TAK41 (TAK17 (1- X) Y Z)
(TAK51 (1- Y) Z X)
(TAK97 (1- Z) X Y)))))
(DEFUN TAK41 (X Y Z)
(COND ((NOT (< Y X)) Z)
(T (TAK42 (TAK54 (1- X) Y Z)
(TAK62 (1- Y) Z X)
(TAK14 (1- Z) X Y)))))
(DEFUN TAK42 (X Y Z)
(COND ((NOT (< Y X)) Z)
(T (TAK43 (TAK91 (1- X) Y Z)
(TAK73 (1- Y) Z X)
(TAK31 (1- Z) X Y)))))
(DEFUN TAK43 (X Y Z)
(COND ((NOT (< Y X)) Z)
(T (TAK44 (TAK28 (1- X) Y Z)
(TAK84 (1- Y) Z X)
(TAK48 (1- Z) X Y)))))
(DEFUN TAK44 (X Y Z)
(COND ((NOT (< Y X)) Z)
(T (TAK45 (TAK65 (1- X) Y Z)
(TAK95 (1- Y) Z X)
(TAK65 (1- Z) X Y)))))
(DEFUN TAK45 (X Y Z)
(COND ((NOT (< Y X)) Z)
(T (TAK46 (TAK2 (1- X) Y Z)
(TAK6 (1- Y) Z X)
(TAK82 (1- Z) X Y)))))
(DEFUN TAK46 (X Y Z)
(COND ((NOT (< Y X)) Z)
(T (TAK47 (TAK39 (1- X) Y Z)
(TAK17 (1- Y) Z X)
(TAK99 (1- Z) X Y)))))
(DEFUN TAK47 (X Y Z)
(COND ((NOT (< Y X)) Z)
(T (TAK48 (TAK76 (1- X) Y Z)
(TAK28 (1- Y) Z X)
(TAK16 (1- Z) X Y)))))
(DEFUN TAK48 (X Y Z)
(COND ((NOT (< Y X)) Z)
(T (TAK49 (TAK13 (1- X) Y Z)
(TAK39 (1- Y) Z X)
(TAK33 (1- Z) X Y)))))
(DEFUN TAK49 (X Y Z)
(COND ((NOT (< Y X)) Z)
(T (TAK50 (TAK50 (1- X) Y Z)
(TAK50 (1- Y) Z X)
(TAK50 (1- Z) X Y)))))
(DEFUN TAK50 (X Y Z)
(COND ((NOT (< Y X)) Z)
(T (TAK51 (TAK87 (1- X) Y Z)
(TAK61 (1- Y) Z X)
(TAK67 (1- Z) X Y)))))
(DEFUN TAK51 (X Y Z)
(COND ((NOT (< Y X)) Z)
(T (TAK52 (TAK24 (1- X) Y Z)
(TAK72 (1- Y) Z X)
(TAK84 (1- Z) X Y)))))
(DEFUN TAK52 (X Y Z)
(COND ((NOT (< Y X)) Z)
(T (TAK53 (TAK61 (1- X) Y Z)
(TAK83 (1- Y) Z X)
(TAK1 (1- Z) X Y)))))
(DEFUN TAK53 (X Y Z)
(COND ((NOT (< Y X)) Z)
(T (TAK54 (TAK98 (1- X) Y Z)
(TAK94 (1- Y) Z X)
(TAK18 (1- Z) X Y)))))
(DEFUN TAK54 (X Y Z)
(COND ((NOT (< Y X)) Z)
(T (TAK55 (TAK35 (1- X) Y Z)
(TAK5 (1- Y) Z X)
(TAK35 (1- Z) X Y)))))
(DEFUN TAK55 (X Y Z)
(COND ((NOT (< Y X)) Z)
(T (TAK56 (TAK72 (1- X) Y Z)
(TAK16 (1- Y) Z X)
(TAK52 (1- Z) X Y)))))
(DEFUN TAK56 (X Y Z)
(COND ((NOT (< Y X)) Z)
(T (TAK57 (TAK9 (1- X) Y Z)
(TAK27 (1- Y) Z X)
(TAK69 (1- Z) X Y)))))
(DEFUN TAK57 (X Y Z)
(COND ((NOT (< Y X)) Z)
(T (TAK58 (TAK46 (1- X) Y Z)
(TAK38 (1- Y) Z X)
(TAK86 (1- Z) X Y)))))
(DEFUN TAK58 (X Y Z)
(COND ((NOT (< Y X)) Z)
(T (TAK59 (TAK83 (1- X) Y Z)
(TAK49 (1- Y) Z X)
(TAK3 (1- Z) X Y)))))
(DEFUN TAK59 (X Y Z)
(COND ((NOT (< Y X)) Z)
(T (TAK60 (TAK20 (1- X) Y Z)
(TAK60 (1- Y) Z X)
(TAK20 (1- Z) X Y)))))
(DEFUN TAK60 (X Y Z)
(COND ((NOT (< Y X)) Z)
(T (TAK61 (TAK57 (1- X) Y Z)
(TAK71 (1- Y) Z X)
(TAK37 (1- Z) X Y)))))
(DEFUN TAK61 (X Y Z)
(COND ((NOT (< Y X)) Z)
(T (TAK62 (TAK94 (1- X) Y Z)
(TAK82 (1- Y) Z X)
(TAK54 (1- Z) X Y)))))
(DEFUN TAK62 (X Y Z)
(COND ((NOT (< Y X)) Z)
(T (TAK63 (TAK31 (1- X) Y Z)
(TAK93 (1- Y) Z X)
(TAK71 (1- Z) X Y)))))
(DEFUN TAK63 (X Y Z)
(COND ((NOT (< Y X)) Z)
(T (TAK64 (TAK68 (1- X) Y Z)
(TAK4 (1- Y) Z X)
(TAK88 (1- Z) X Y)))))
(DEFUN TAK64 (X Y Z)
(COND ((NOT (< Y X)) Z)
(T (TAK65 (TAK5 (1- X) Y Z)
(TAK15 (1- Y) Z X)
(TAK5 (1- Z) X Y)))))
(DEFUN TAK65 (X Y Z)
(COND ((NOT (< Y X)) Z)
(T (TAK66 (TAK42 (1- X) Y Z)
(TAK26 (1- Y) Z X)
(TAK22 (1- Z) X Y)))))
(DEFUN TAK66 (X Y Z)
(COND ((NOT (< Y X)) Z)
(T (TAK67 (TAK79 (1- X) Y Z)
(TAK37 (1- Y) Z X)
(TAK39 (1- Z) X Y)))))
(DEFUN TAK67 (X Y Z)
(COND ((NOT (< Y X)) Z)
(T (TAK68 (TAK16 (1- X) Y Z)
(TAK48 (1- Y) Z X)
(TAK56 (1- Z) X Y)))))
(DEFUN TAK68 (X Y Z)
(COND ((NOT (< Y X)) Z)
(T (TAK69 (TAK53 (1- X) Y Z)
(TAK59 (1- Y) Z X)
(TAK73 (1- Z) X Y)))))
(DEFUN TAK69 (X Y Z)
(COND ((NOT (< Y X)) Z)
(T (TAK70 (TAK90 (1- X) Y Z)
(TAK70 (1- Y) Z X)
(TAK90 (1- Z) X Y)))))
(DEFUN TAK70 (X Y Z)
(COND ((NOT (< Y X)) Z)
(T (TAK71 (TAK27 (1- X) Y Z)
(TAK81 (1- Y) Z X)
(TAK7 (1- Z) X Y)))))
(DEFUN TAK71 (X Y Z)
(COND ((NOT (< Y X)) Z)
(T (TAK72 (TAK64 (1- X) Y Z)
(TAK92 (1- Y) Z X)
(TAK24 (1- Z) X Y)))))
(DEFUN TAK72 (X Y Z)
(COND ((NOT (< Y X)) Z)
(T (TAK73 (TAK1 (1- X) Y Z)
(TAK3 (1- Y) Z X)
(TAK41 (1- Z) X Y)))))
(DEFUN TAK73 (X Y Z)
(COND ((NOT (< Y X)) Z)
(T (TAK74 (TAK38 (1- X) Y Z)
(TAK14 (1- Y) Z X)
(TAK58 (1- Z) X Y)))))
(DEFUN TAK74 (X Y Z)
(COND ((NOT (< Y X)) Z)
(T (TAK75 (TAK75 (1- X) Y Z)
(TAK25 (1- Y) Z X)
(TAK75 (1- Z) X Y)))))
(DEFUN TAK75 (X Y Z)
(COND ((NOT (< Y X)) Z)
(T (TAK76 (TAK12 (1- X) Y Z)
(TAK36 (1- Y) Z X)
(TAK92 (1- Z) X Y)))))
(DEFUN TAK76 (X Y Z)
(COND ((NOT (< Y X)) Z)
(T (TAK77 (TAK49 (1- X) Y Z)
(TAK47 (1- Y) Z X)
(TAK9 (1- Z) X Y)))))
(DEFUN TAK77 (X Y Z)
(COND ((NOT (< Y X)) Z)
(T (TAK78 (TAK86 (1- X) Y Z)
(TAK58 (1- Y) Z X)
(TAK26 (1- Z) X Y)))))
(DEFUN TAK78 (X Y Z)
(COND ((NOT (< Y X)) Z)
(T (TAK79 (TAK23 (1- X) Y Z)
(TAK69 (1- Y) Z X)
(TAK43 (1- Z) X Y)))))
(DEFUN TAK79 (X Y Z)
(COND ((NOT (< Y X)) Z)
(T (TAK80 (TAK60 (1- X) Y Z)
(TAK80 (1- Y) Z X)
(TAK60 (1- Z) X Y)))))
(DEFUN TAK80 (X Y Z)
(COND ((NOT (< Y X)) Z)
(T (TAK81 (TAK97 (1- X) Y Z)
(TAK91 (1- Y) Z X)
(TAK77 (1- Z) X Y)))))
(DEFUN TAK81 (X Y Z)
(COND ((NOT (< Y X)) Z)
(T (TAK82 (TAK34 (1- X) Y Z)
(TAK2 (1- Y) Z X)
(TAK94 (1- Z) X Y)))))
(DEFUN TAK82 (X Y Z)
(COND ((NOT (< Y X)) Z)
(T (TAK83 (TAK71 (1- X) Y Z)
(TAK13 (1- Y) Z X)
(TAK11 (1- Z) X Y)))))
(DEFUN TAK83 (X Y Z)
(COND ((NOT (< Y X)) Z)
(T (TAK84 (TAK8 (1- X) Y Z)
(TAK24 (1- Y) Z X)
(TAK28 (1- Z) X Y)))))
(DEFUN TAK84 (X Y Z)
(COND ((NOT (< Y X)) Z)
(T (TAK85 (TAK45 (1- X) Y Z)
(TAK35 (1- Y) Z X)
(TAK45 (1- Z) X Y)))))
(DEFUN TAK85 (X Y Z)
(COND ((NOT (< Y X)) Z)
(T (TAK86 (TAK82 (1- X) Y Z)
(TAK46 (1- Y) Z X)
(TAK62 (1- Z) X Y)))))
(DEFUN TAK86 (X Y Z)
(COND ((NOT (< Y X)) Z)
(T (TAK87 (TAK19 (1- X) Y Z)
(TAK57 (1- Y) Z X)
(TAK79 (1- Z) X Y)))))
(DEFUN TAK87 (X Y Z)
(COND ((NOT (< Y X)) Z)
(T (TAK88 (TAK56 (1- X) Y Z)
(TAK68 (1- Y) Z X)
(TAK96 (1- Z) X Y)))))
(DEFUN TAK88 (X Y Z)
(COND ((NOT (< Y X)) Z)
(T (TAK89 (TAK93 (1- X) Y Z)
(TAK79 (1- Y) Z X)
(TAK13 (1- Z) X Y)))))
(DEFUN TAK89 (X Y Z)
(COND ((NOT (< Y X)) Z)
(T (TAK90 (TAK30 (1- X) Y Z)
(TAK90 (1- Y) Z X)
(TAK30 (1- Z) X Y)))))
(DEFUN TAK90 (X Y Z)
(COND ((NOT (< Y X)) Z)
(T (TAK91 (TAK67 (1- X) Y Z)
(TAK1 (1- Y) Z X)
(TAK47 (1- Z) X Y)))))
(DEFUN TAK91 (X Y Z)
(COND ((NOT (< Y X)) Z)
(T (TAK92 (TAK4 (1- X) Y Z)
(TAK12 (1- Y) Z X)
(TAK64 (1- Z) X Y)))))
(DEFUN TAK92 (X Y Z)
(COND ((NOT (< Y X)) Z)
(T (TAK93 (TAK41 (1- X) Y Z)
(TAK23 (1- Y) Z X)
(TAK81 (1- Z) X Y)))))
(DEFUN TAK93 (X Y Z)
(COND ((NOT (< Y X)) Z)
(T (TAK94 (TAK78 (1- X) Y Z)
(TAK34 (1- Y) Z X)
(TAK98 (1- Z) X Y)))))
(DEFUN TAK94 (X Y Z)
(COND ((NOT (< Y X)) Z)
(T (TAK95 (TAK15 (1- X) Y Z)
(TAK45 (1- Y) Z X)
(TAK15 (1- Z) X Y)))))
(DEFUN TAK95 (X Y Z)
(COND ((NOT (< Y X)) Z)
(T (TAK96 (TAK52 (1- X) Y Z)
(TAK56 (1- Y) Z X)
(TAK32 (1- Z) X Y)))))
(DEFUN TAK96 (X Y Z)
(COND ((NOT (< Y X)) Z)
(T (TAK97 (TAK89 (1- X) Y Z)
(TAK67 (1- Y) Z X)
(TAK49 (1- Z) X Y)))))
(DEFUN TAK97 (X Y Z)
(COND ((NOT (< Y X)) Z)
(T (TAK98 (TAK26 (1- X) Y Z)
(TAK78 (1- Y) Z X)
(TAK66 (1- Z) X Y)))))
(DEFUN TAK98 (X Y Z)
(COND ((NOT (< Y X)) Z)
(T (TAK99 (TAK63 (1- X) Y Z)
(TAK89 (1- Y) Z X)
(TAK83 (1- Z) X Y)))))
(DEFUN TAK99 (X Y Z)
(COND ((NOT (< Y X)) Z)
(T (TAK0 (TAK0 (1- X) Y Z)
(TAK0 (1- Y) Z X)
(TAK0 (1- Z) X Y)))))
;;;END
;;;BEGIN
;;;PUZZLE
(declare (special size classmax typemax d)
(fixnum (place fixnum fixnum)
size classmax typemax d))
;(defmacro tab () '(tyo 9.))
(setq true t false ())
(declare (setq true t false ()))
(setq size 511.)
(setq classmax 3.)
(setq typemax 12.)
(setq d 8.)
(declare (special iii kount)
(fixnum iii i j k kount m n))
(declare (array* (fixnum piececount 1 class 1 piecemax 1)
(notype puzzle 1 p 2)))
(array piececount fixnum (1+ classmax))
(array class fixnum (1+ typemax))
(array piecemax fixnum (1+ typemax))
(array puzzle t (1+ size))
(array p t (1+ typemax) (1+ size))
(defun fit (i j)
(let ((end (piecemax i)))
(do ((k 0 (1+ k)))
((> k end) #.true)
(cond ((p i k)
(cond ((puzzle (+ j k))
(return #.false))))))))
(defun place (i j)
(let ((end (piecemax i)))
(do ((k 0 (1+ k)))
((> k end))
(cond ((p i k)
(store (puzzle (+ j k)) #.true))))
(store (piececount (class i)) (- (piececount (class i)) 1))
(do ((k j (1+ k)))
((> k size)
; (terpri)
; (princ "Puzzle filled")
0)
(cond ((not (puzzle k))
(return k))))))
(defun remove (i j)
(let ((end (piecemax i)))
(do ((k 0 (1+ k)))
((> k end))
(cond ((p i k) (store (puzzle (+ j k)) #.false))))
(store (piececount (class i)) (+ (piececount (class i)) 1))))
(defun trial (j)
(let ((k 0))
(do ((i 0 (1+ i)))
((> i typemax) (setq kount (1+ kount))
#.false)
(cond ((not (= (piececount (class i)) 0))
(cond ((fit i j)
(setq k (place i j))
(cond ((or (trial k)
(= k 0))
; (terpri)
; (princ "Piece") (tab)
; (princ (+ i 1)) (tab)
; (princ "at")(tab)(princ (+ k 1))
(setq kount (+ kount 1))
(return #.true))
(t (remove i j))))))))))
(defun definepiece (iclass ii jj kk)
(let ((index 0))
(do ((i 0 (1+ i)))
((> i ii))
(do ((j 0 (1+ j)))
((> j jj))
(do ((k 0 (1+ k)))
((> k kk))
(setq index (+ i (* d (+ j (* d k)))))
(store (p iii index) #.true))))
(store (class iii) iclass)
(store (piecemax iii) index)
(cond ((not (= iii typemax))
(setq iii (+ iii 1))))))
(defun start ()
(do ((m 0 (1+ m)))
((> m size))
(store (puzzle m) #.true))
(do ((i 1 (1+ i)))
((> i 5))
(do ((j 1 (1+ j)))
((> j 5))
(do ((k 1 (1+ k)))
((> k 5))
(store (puzzle (+ i (* d (+ j (* d k))))) #.false))))
(do ((i 0 (1+ i)))
((> i typemax))
(do ((m 0 (1+ m)))
((> m size))
(store (p i m) #.false)))
(setq iii 0)
(definePiece 0 3 1 0)
(definePiece 0 1 0 3)
(definePiece 0 0 3 1)
(definePiece 0 1 3 0)
(definePiece 0 3 0 1)
(definePiece 0 0 1 3)
(definePiece 1 2 0 0)
(definePiece 1 0 2 0)
(definePiece 1 0 0 2)
(definePiece 2 1 1 0)
(definePiece 2 1 0 1)
(definePiece 2 0 1 1)
(definePiece 3 1 1 1)
(store (pieceCount 0) 13.)
(store (pieceCount 1) 3)
(store (pieceCount 2) 1)
(store (pieceCount 3) 1)
(let ((m (+ 1 (* d (+ 1 d))))
(n 0)(kount 0))
(cond ((fit 0 m) (setq n (place 0 m)))
(t (terpri)(princ "Error")))
(cond ((trial n)
(terpri)(princ "success in ")(princ kount) (princ " trials"))
(t (terpri)(princ "failure")))
(terpri)))
(include "timer.lsp")
(timer timit
(start))
;;;END
;;;BEGIN
;;; DERIV
(DECLARE (MAPEX T))
(DEFUN DER1 (A) (LIST 'QUOTIENT (DERIV A) A))
(DEFUN DERIV (A)
(COND
((ATOM A)
(COND ((EQ A 'X) 1) (T 0)))
((EQ (CAR A) 'PLUS) (CONS 'PLUS (MAPCAR 'DERIV (CDR A))))
((EQ (CAR A) 'DIFFERENCE)
(CONS 'DIFFERENCE (MAPCAR 'DERIV
(CDR A))))
((EQ (CAR A) 'TIMES)
(LIST 'TIMES
A
(CONS 'PLUS (MAPCAR 'DER1 (CDR A)))))
((EQ (CAR A) 'QUOTIENT)
(LIST 'DIFFERENCE
(LIST 'QUOTIENT
(DERIV (CADR A))
(CADDR A))
(LIST 'QUOTIENT
(CADR A)
(LIST 'TIMES
(CADDR A)
(CADDR A)
(DERIV (CADDR A))))))
(T 'ERROR)))
(DEFUN RUN ()
(DECLARE (FIXNUM I))
(DO ((I 0 (1+ I)))
((= I 1000.))
(DERIV '(PLUS (TIMES 3 X X) (TIMES A X X) (TIMES B X) 5))
(DERIV '(PLUS (TIMES 3 X X) (TIMES A X X) (TIMES B X) 5))
(DERIV '(PLUS (TIMES 3 X X) (TIMES A X X) (TIMES B X) 5))
(DERIV '(PLUS (TIMES 3 X X) (TIMES A X X) (TIMES B X) 5))
(DERIV '(PLUS (TIMES 3 X X) (TIMES A X X) (TIMES B X) 5))))
(include "timer.lsp")
(timer timit
(run))
;;;END
;;;BEGIN
;;;DDERIV
(DECLARE (MAPEX T))
(DEFUN DER1 (A) (LIST 'QUOTIENT (DERIV A) A))
(DEFUN (PLUS DERIV) (A)
(CONS 'PLUS (MAPCAR 'DERIV A)))
(DEFUN (DIFFERENCE DERIV) (A)
(CONS 'DIFFERENCE (MAPCAR 'DERIV
A)))
(DEFUN (TIMES DERIV) (A)
(LIST 'TIMES (CONS 'TIMES A)
(CONS 'PLUS (MAPCAR 'DER1 A))))
(DEFUN (QUOTIENT DERIV) (A)
(LIST 'DIFFERENCE
(LIST 'QUOTIENT
(DERIV (CAR A))
(CADR A))
(LIST 'QUOTIENT
(CAR A)
(LIST 'TIMES
(CADR A)
(CADR A)
(DERIV (CADR A))))))
(DEFUN DERIV (A)
(COND
((ATOM A)
(COND ((EQ A 'X) 1) (T 0)))
(T (LET ((DERIV (GET (CAR A) 'DERIV)))
(COND (DERIV (FUNCALL DERIV (CDR A)))
(T 'ERROR))))))
(DEFUN RUN ()
(DECLARE (FIXNUM I))
(DO ((I 0 (1+ I)))
((= I 1000.))
(DERIV '(PLUS (TIMES 3 X X) (TIMES A X X) (TIMES B X) 5))
(DERIV '(PLUS (TIMES 3 X X) (TIMES A X X) (TIMES B X) 5))
(DERIV '(PLUS (TIMES 3 X X) (TIMES A X X) (TIMES B X) 5))
(DERIV '(PLUS (TIMES 3 X X) (TIMES A X X) (TIMES B X) 5))
(DERIV '(PLUS (TIMES 3 X X) (TIMES A X X) (TIMES B X) 5))))
(include "timer.lsp")
(timer timit
(run))
;;;END
;;;BEGIN
;;;FDDERIV
(DECLARE (MAPEX T))
(DEFUN DER1 (A) (LIST 'QUOTIENT (DERIV A) A))
(DEFUN (PLUS DERIV DERIV) (A)
(CONS 'PLUS (MAPCAR 'DERIV A)))
(DEFUN (DIFFERENCE DERIV DERIV) (A)
(CONS 'DIFFERENCE (MAPCAR 'DERIV
A)))
(DEFUN (TIMES DERIV DERIV) (A)
(LIST 'TIMES (CONS 'TIMES A)
(CONS 'PLUS (MAPCAR 'DER1 A))))
(DEFUN (QUOTIENT DERIV DERIV) (A)
(LIST 'DIFFERENCE
(LIST 'QUOTIENT
(DERIV (CAR A))
(CADR A))
(LIST 'QUOTIENT
(CAR A)
(LIST 'TIMES
(CADR A)
(CADR A)
(DERIV (CADR A))))))
(DEFUN DERIV (A)
(COND
((ATOM A)
(COND ((EQ A 'X) 1) (T 0)))
(T (LET ((DERIV (GET (CAR A) 'DERIV)))
(COND (DERIV (SUBRCALL T DERIV (CDR A)))
(T 'ERROR))))))
(DEFUN RUN ()
(DECLARE (FIXNUM I))
(DO ((I 0 (1+ I)))
((= I 1000.))
(DERIV '(PLUS (TIMES 3 X X) (TIMES A X X) (TIMES B X) 5))
(DERIV '(PLUS (TIMES 3 X X) (TIMES A X X) (TIMES B X) 5))
(DERIV '(PLUS (TIMES 3 X X) (TIMES A X X) (TIMES B X) 5))
(DERIV '(PLUS (TIMES 3 X X) (TIMES A X X) (TIMES B X) 5))
(DERIV '(PLUS (TIMES 3 X X) (TIMES A X X) (TIMES B X) 5))))
(include "timer.lsp")
(timer timit
(run))
;;;END
;;;BEGIN
;;;FFT
;Barrow FFT
;Here is the Barrow FFT benchmark which tests floating operations
;of various types, including flonum arrays. (ARRAYCALL FLONUM A I)
;accesses the I'th element of the FLONUM array A, where these arrays are
;0-based. (STORE (ARRAYCALL FLONUM A I) V) stores the value V in the
;I'th element of the FLONUM array A.
;There was a fair amount of FLONUM GC's in the SAIL MacLisp run, which,
;when it needed to CORE up during GC, took 4.5 seconds of CPU time for the
;computation and 15 seconds for GC. Other configurations of memory required
;only 1.5 seconds for GC.
;Refer to this as FFT.
; -rpg-
;;; *-*lisp*-*
;;; From Rich Duda, by way of Harry Barrow -- 3/26/82
(DEFUN FFT ;Fast Fourier Transform
(AREAL AIMAG) ;AREAL = real part
(PROG ;AIMAG = imaginary part
(AR AI PI I J K M N LE LE1 IP NV2 NM1 UR UI WR WI TR TI)
(SETQ AR (GET AREAL 'ARRAY)) ;Initialize
(SETQ AI (GET AIMAG 'ARRAY))
(SETQ PI 3.141592653589793)
(SETQ N (CADR (ARRAYDIMS AR)))
(SETQ N (1- N))
(SETQ NV2 (// N 2))
(SETQ NM1 (1- N))
(SETQ M 0) ;Compute M = log(N)
(SETQ I 1)
L1 (COND
((< I N)(SETQ M (1+ M))(SETQ I (+ I I))(GO L1)))
(COND ((NOT (EQUAL N (↑ 2 M)))
(PRINC "Error ... array size not a power of two.")
(READ)
(RETURN (TERPRI))))
(SETQ J 1) ;Interchange elements
(SETQ I 1) ;in bit-reversed order
L3 (COND ((< I J)
(SETQ TR (ARRAYCALL FLONUM AR J))
(SETQ TI (ARRAYCALL FLONUM AI J))
(STORE (ARRAYCALL FLONUM AR J) (ARRAYCALL FLONUM AR
I))
(STORE (ARRAYCALL FLONUM AI J) (ARRAYCALL FLONUM AI
I))
(STORE (ARRAYCALL FLONUM AR I) TR)
(STORE (ARRAYCALL FLONUM AI I) TI)))
(SETQ K NV2)
L6 (COND ((< K J) (SETQ J (- J K))(SETQ K (// K 2))(GO L6)))
(SETQ J (+ J K))
(SETQ I (1+ I))
(COND ((< I N)(GO L3)))
(DO L 1 (1+ L) (> L M) ;Loop thru stages
(SETQ LE (↑ 2 L))
(SETQ LE1 (// LE 2))
(SETQ UR 1.0)
(SETQ UI 0.0)
(SETQ WR (COS (//$ PI (FLOAT LE1))))
(SETQ WI (SIN (//$ PI (FLOAT LE1))))
(DO J 1 (1+ J) (> J LE1) ;Loop thru butterflies
(DO I J (+ I LE) (> I N) ;Do a butterfly
(SETQ IP (+ I LE1))
(SETQ TR (-$ (*$ (ARRAYCALL FLONUM AR IP) UR)
(*$ (ARRAYCALL FLONUM AI IP) UI)))
(SETQ TI (+$ (*$ (ARRAYCALL FLONUM AR IP) UI)
(*$ (ARRAYCALL FLONUM AI IP) UR)))
(STORE (ARRAYCALL FLONUM AR IP)
(-$ (ARRAYCALL FLONUM AR I) TR))
(STORE (ARRAYCALL FLONUM AI IP)
(-$ (ARRAYCALL FLONUM AI I) TI))
(STORE (ARRAYCALL FLONUM AR I)
(+$ (ARRAYCALL FLONUM AR I) TR))
(STORE (ARRAYCALL FLONUM AI I)
(+$ (ARRAYCALL FLONUM AI I) TI)))
(SETQ TR (-$ (*$ UR WR) (*$ UI WI)))
(SETQ TI (+$ (*$ UR WI) (*$ UI WR)))
(SETQ UR TR)
(SETQ UI TI)))
(RETURN T)))
;;; Sets up the two arrays
(SETQ RE (ARRAY RE FLONUM 1025.))
(SETQ IM (ARRAY IM FLONUM 1025.))
;;; The timer which does 10 calls on FFT
(include "timer.lsp")
(timer timit
(do ((ntimes 0 (1+ ntimes)))
((= ntimes 10.))
(fft 're 'im)))
;;;END
;;;BEGIN
;;;BROWSE
;;; Benchmark to create and browse through an AI-like data base of units
;;; n is # of symbols
;;; m is maximum amount of stuff on the plist
;;; npats is the number of basic patterns on the unit
;;; ipats is the instantiated copies of the patterns
(declare (fixsw t))
(defun init (n m npats ipats)
(let ((ipats (subst () () ipats)))
(do ((p ipats (cdr p)))
((null (cdr p)) (rplacd p ipats)))
(do ((n n (1- n))
(i m (cond ((= i 0) m)
(t (1- i))))
(name (intern (gensym)) (intern (gensym)))
(a ()))
((= n 0) a)
(push name a)
(do ((i i (1- i)))
((= i 0))
(putprop name() (gensym)))
(putprop
name
(do ((i npats (1- i))
(ipats ipats (cdr ipats))
(a ()))
((= i 0) a)
(push (car ipats) a))
'pattern)
(do ((j (- m i) (1- j)))
((= j 0))
(putprop name () (gensym))))))
(defmacro mod (x n) `(remainder ,x ,n))
(declare (special rand)(fixnum rand))
(setq rand 21.)
(defun seed () (setq rand 21.))
(defun random () (setq rand (mod (* rand 17.) 251.)))
(defun randomize (l)
(do ((a ()))
((null l) a)
(let ((n (mod (random) (length l))))
(cond ((= n 0)
(push (car l) a)
(setq l (cdr l)))
(t
(do ((n n (1- n))
(x l (cdr x)))
((= n 1)
(push (cadr x) a)
(rplacd x (cddr x)))))))))
(defmacro char1 (x) `(getchar ,x 1))
(defun match (pat dat alist)
(cond ((null pat)
(null dat))
((null dat) ())
((or (eq (car pat) '?)
(eq (car pat)
(car dat)))
(match (cdr pat) (cdr dat) alist))
((eq (car pat) '*)
(or (match (cdr pat) dat alist)
(match (cdr pat) (cdr dat) alist)
(match pat (cdr dat) alist)))
(t (cond ((atom (car pat))
(cond ((eq (char1 (car pat)) '?)
(let ((val (assq (car pat) alist)))
(cond (val (match (cons (cdr val)
(cdr pat))
dat alist))
(t (match (cdr pat)
(cdr dat)
(cons (cons (car pat)
(car dat))
alist))))))
((eq (char1 (car pat)) '*)
(let ((val (assq (car pat) alist)))
(cond (val (match (append (cdr val)
(cdr pat))
dat alist))
(t
(do ((l () (nconc l (ncons (car d))))
(e (cons () dat) (cdr e))
(d dat (cdr d)))
((null e) ())
(cond ((match (cdr pat) d
(cons (cons (car pat) l)
alist))
(return t))))))))))
(t (and
(not (atom (car dat)))
(match (car pat)
(car dat) alist)
(match (cdr pat)
(cdr dat) alist)))))))
(defun browse ()
(seed)
(investigate (randomize
(init 100. 10. 4. '((a a a b b b b a a a a a b b a a a)
(a a b b b b a a
(a a)(b b))
(a a a b (b a) b a b a))))
'((*a ?b *b ?b a *a a *b *a)
(*a *b *b *a (*a) (*b))
(? ? * (b a) * ? ?))))
(defun investigate (units pats)
(do ((units units (cdr units)))
((null units))
(do ((pats pats (cdr pats)))
((null pats))
(do ((p (get (car units) 'pattern)
(cdr p)))
((null p))
(match (car pats) (car p) ())))))
(include "timer.lsp")
(timer timit
(browse))
;;;END
;;;BEGIN
;;;TRAVERSE
;;; Benchmark to create once and traverse a Structure
(declare (fasload struct fas dsk (mac lsp)))
(defstruct node
(parents ())
(sons ())
(sn (snb))
(entry1 ())
(entry2 ())
(entry3 ())
(entry4 ())
(entry5 ())
(entry6 ())
(mark ()))
(declare (special sn))
(defun snb () (setq sn (1+ sn)))
(setq sn 0)
(defmacro mod (x n) `(remainder ,x ,n))
(declare (special rand)(fixnum rand))
(setq rand 21.)
(defun seed () (setq rand 21.))
(defun random () (setq rand (mod (* rand 17.) 251.)))
(defun remove (n q)
(cond ((eq (cdr (car q)) (car q))
(prog2 () (caar q) (rplaca q ())))
((= n 0)
(prog2 () (caar q)
(do ((p (car q) (cdr p)))
((eq (cdr p) (car q))
(rplaca q
(rplacd p (cdr (car q))))))))
(t (do ((n n (1- n))
(q (car q) (cdr q))
(p (cdr (car q)) (cdr p)))
((= n 0) (prog2 () (car q) (rplacd q p)))))))
(defun select (n q)
(do ((n n (1- n))
(q (car q) (cdr q)))
((= n 0) (car q))))
(defun add (a q)
(cond ((null q)
`(,(let ((x `(,a)))
(rplacd x x) x)))
((null (car q))
(let ((x `(,a)))
(rplacd x x)
(rplaca q x)))
(t (rplaca q
(rplacd (car q) `(,a .,(cdr (car q))))))))
(defun create-structure (n)
(let ((a `(,(make-node))))
(do ((m (1- n) (1- m))
(p a))
((= m 0) (setq a `(,(rplacd p a)))
(do ((unused a)
(used (add (remove 0 a) ()))
(x) (y))
((null (car unused))
(find-root (select 0 used) n))
(setq x (remove (mod (random) n) unused))
(setq y (select (mod (random) n) used))
(add x used)
(setf (sons y) `(,x .,(sons y)))
(setf (parents x) `(,y .,(parents x))) ))
(push (make-node) a))))
(defun find-root (node n)
(do ((n n (1- n)))
((= n 0) node)
(cond ((null (parents node))
(return node))
(t (setq node (car (parents node)))))))
(declare (special count marker))
(setq count 0 marker ())
(defun travers (node mark)
(cond ((eq (mark node) mark) ())
(t (setf (mark node) mark)
(setq count (1+ count))
(setf (entry1 node) (not (entry1 node)))
(setf (entry2 node) (not (entry1 node)))
(setf (entry3 node) (not (entry1 node)))
(setf (entry4 node) (not (entry1 node)))
(setf (entry5 node) (not (entry1 node)))
(setf (entry6 node) (not (entry1 node)))
(do ((sons (sons node) (cdr sons)))
((null sons) ())
(travers (car sons) mark)))))
(defun traverse (root)
(let ((count 0))
(travers root (setq marker (not marker)))
count))
(include "timer.lsp")
(declare (special root))
(timer init-timit
(prog2 (setq root (create-structure 100.)) ()))
(timer timit
(do ((i 50. (1- i)))
((= i 0))
(traverse root)
(traverse root)
(traverse root)
(traverse root)
(traverse root)))
;;;END
;;;BEGIN
;;;DIV2
;;; Dividing by 2 using lists of n ()'s
(declare (fixsw t))
(defun create-n (n)
(do ((n n (1- n))
(a () (push () a)))
((= n 0) a)))
(defun div2 (l)
(do ((l l (cddr l))
(a () (push (car l) a)))
((null l) a)))
(defun dv2 (l)
(cond ((null l) ())
(t (cons (car l) (dv2 (cddr l))))))
(defun test1 (l)
(do ((i 300. (1- i)))
((= i 0))
(div2 l)
(div2 l)
(div2 l)
(div2 l)))
(defun test2 (l)
(do ((i 300. (1- i)))
((= i 0))
(dv2 l)
(dv2 l)
(dv2 l)
(dv2 l)))
(declare (special l))
(setq l (create-n 200.))
(include "timer.lsp")
(timer timit1
(test1 l))
(timer timit2
(test2 l))
;;;END
;;;BEGIN
;;;FPRINT
;;; Benchmark to print to a file.
(declare (fixsw t))
(defun init (m n atoms)
(let ((atoms (subst () () atoms)))
(do ((a atoms (cdr a)))
((null (cdr a)) (rplacd a atoms)))
(init1 m n atoms)))
(defun init1 (m n atoms)
(cond ((= m 0) (pop atoms))
(t (do ((i n (- i 2))
(a ()))
((< i 1) a)
(push (pop atoms) a)
(push (init1 (1- m) n atoms) a)))))
(declare (special test-atoms))
(setq test-atoms '(abcdef12 cdefgh23 efghij34 ghijkl45 ijklmn56 klmnop67
mnopqr78 opqrst89 qrstuv90 stuvwx01 uvwxyz12
wxyzab23 xyzabc34 123456ab 234567bc 345678cd
456789de 567890ef 678901fg 789012gh 890123hi))
(declare (special test-pattern))
(setq test-pattern (init 6. 6. test-atoms))
(defun fprint ()
(cond ((probef "fprint.tst")
(deletef "fprint.tst")))
(let ((f (open "fprint.tst" '(out ascii))))
(print test-pattern f)
(close f)))
(cond ((probef "fprint.tst"))
(t
(let ((f (open "fprint.tst" '(out ascii))))
(print test-pattern f)
(close f))))
(include "timer.lsp")
(timer timit (fprint))
;;;END
;;;BEGIN
;;;FREAD
;;; Benchmark to read from a file.
(declare (fixsw t))
(defun fread ()
(let ((f (open "fprint.tst" '(in ascii))))
(read f)
(close f)))
(cond ((probef "fprint.tst"))
(t
(terpri)
(princ "Define FPRINT.TST using the FPRINT benchmark!")
(let ((f (open "fprint.tst" '(out ascii))))
(print test-pattern f)
(close f))))
(include "timer.lsp")
(timer timit (fread))
;;;END
;;;BEGIN
;;;TPRINT
;;; Benchmark to print and read to the terminal
(declare (fixsw t))
(defun init (m n atoms)
(let ((atoms (subst () () atoms)))
(do ((a atoms (cdr a)))
((null (cdr a)) (rplacd a atoms)))
(init1 m n atoms)))
(defun init1 (m n atoms)
(cond ((= m 0) (pop atoms))
(t (do ((i n (- i 2))
(a ()))
((< i 1) a)
(push (pop atoms) a)
(push (init1 (1- m) n atoms) a)))))
(declare (special test-atoms))
(setq test-atoms '(abc1 cde2 efg3 ghi4 ijk5 klm6 mno7 opq8 qrs9
stu0 uvw1 wxy2 xyz3 123a 234b 345c 456d
567d 678e 789f 890g))
(declare (special test-pattern))
(setq test-pattern (init 6. 6. test-atoms))
(include "timer.lsp")
(timer timit (print test-pattern))
;;;END
;;;BEGIN
;;;DESTRU
;;; Destructive operation benchmark
(declare (fixsw t))
(defun destructive (n m)
(let ((l (do ((i 10. (1- i))
(a () (push () a)))
((= i 0) a))))
(do ((i n (1- i)))
((= i 0))
(cond ((null (car l))
(do ((l l (cdr l)))
((null l))
(or (car l)
(rplaca l (ncons ())))
(nconc (car l)
(do ((j m (1- j))
(a () (push () a)))
((= j 0) a)))))
(t
(do ((l1 l (cdr l1))
(l2 (cdr l) (cdr l2)))
((null l2))
(rplacd (do ((j (// (length (car l2)) 2) (1- j))
(a (car l2) (cdr a)))
((= j 0) a)
(rplaca a i))
(let ((n (// (length (car l1)) 2)))
(cond ((= n 0) (rplaca l1 ())
(car l1))
(t
(do ((j n (1- j))
(a (car l1) (cdr a)))
((= j 1)
(prog1 (cdr a)
(rplacd a ())))
(rplaca a i))))))))))))
(include "timer.lsp")
(timer timit (destructive 600. 50.))
;;;END
;;;BEGIN
;;;TRIANG
(declare (array* (fixnum board 1 a 1 b 1 c 1 sequence 1))
(fixsw t)
(special answer final))
(eval-when (compile load eval)
(setq base 10. ibase 10.))
(array board fixnum 16.)
(array sequence fixnum 14.)
(array a fixnum 37.)
(array b fixnum 37.)
(array c fixnum 37.)
(fillarray 'board '(1))
(store (board 5) 0)
(fillarray 'a '(1 2 4 3 5 6 1 3 6 2 5 4 11 12 13 7 8 4
4 7 11 8 12 13 6 10 15 9 14 13 13 14 15 9 10 6))
(fillarray 'b '(2 4 7 5 8 9 3 6 10 5 9 8 12 13 14 8 9 5
2 4 7 5 8 9 3 6 10 5 9 8 12 13 14 8 9 5))
(fillarray 'c '(4 7 11 8 12 13 6 10 15 9 14 13 13 14 15 9 10 6
1 2 4 3 5 6 1 3 6 2 5 4 11 12 13 7 8 4))
(defun last-position ()
(do ((i 1 (1+ i)))
((= i 16.) 0)
(cond ((= 1 (board i)) (return i)))))
(defun try (i depth)
(cond ((= depth 14)
(let ((lp (last-position)))
(cond ((member lp final))
(t (push lp final))))
(push (cdr (listarray 'sequence)) answer) t)
((and (= 1 (board (a i)))
(= 1 (board (b i)))
(= 0 (board (c i))))
(store (board (a i)) 0)
(store (board (b i)) 0)
(store (board (c i)) 1)
(store (sequence depth) i)
(do ((j 0 (1+ j))
(depth (1+ depth)))
((or (= j 36.)
(try j depth)) ()))
(store (board (a i)) 1)
(store (board (b i)) 1)
(store (board (c i)) 0)())))
(defun gogogo (i)
(let ((answer ())
(final ()))
(try i 1)))
(include "timer.lsp")
(timer timit
(gogogo 22.))
(defun test ()
(let ((answer ())
(final ()))
(try 22. 1)
(= (length answer) 775.)))
;;;END
;;;BEGIN
;;;BOYER
;;; The Maclisp Code
(DECLARE (SPECIAL UNIFY-SUBST TEMP-TEMP))
;(DEFUN PTIME NIL (LIST (RUNTIME) (STATUS GCTIME)))
(DEFUN ADD-LEMMA (TERM)
(COND ((AND (NOT (ATOM TERM))
(EQ (CAR TERM)
(QUOTE EQUAL))
(NOT (ATOM (CADR TERM))))
(PUTPROP (CAR (CADR TERM))
(CONS TERM (GET (CAR (CADR TERM))
(QUOTE LEMMAS)))
(QUOTE LEMMAS)))
(T (ERROR (QUOTE ADD-LEMMA-DID-NOT-LIKE-TERM)
TERM))))
(DEFUN ADD-LEMMA-LST (LST)
(COND ((NULL LST)
T)
(T (ADD-LEMMA (CAR LST))
(ADD-LEMMA-LST (CDR LST)))))
(DEFUN APPLY-SUBST (ALIST TERM)
(COND ((ATOM TERM)
(COND ((SETQ TEMP-TEMP (ASSQ TERM ALIST))
(CDR TEMP-TEMP))
(T TERM)))
(T (CONS (CAR TERM)
(APPLY-SUBST-LST ALIST (CDR TERM))))))
(DEFUN APPLY-SUBST-LST (ALIST LST)
(COND ((NULL LST)
NIL)
(T (CONS (APPLY-SUBST ALIST (CAR LST))
(APPLY-SUBST-LST ALIST (CDR LST))))))
(DEFUN FALSEP (X LST)
(OR (EQUAL X (QUOTE (F)))
(MEMBER X LST)))
(DEFUN ONE-WAY-UNIFY (TERM1 TERM2)
(PROGN (SETQ UNIFY-SUBST NIL)
(ONE-WAY-UNIFY1 TERM1 TERM2)))
(DEFUN ONE-WAY-UNIFY1 (TERM1 TERM2)
(COND ((ATOM TERM2)
(COND ((SETQ TEMP-TEMP (ASSQ TERM2 UNIFY-SUBST))
(EQUAL TERM1 (CDR TEMP-TEMP)))
(T (SETQ UNIFY-SUBST (CONS (CONS TERM2 TERM1)
UNIFY-SUBST))
T)))
((ATOM TERM1)
NIL)
((EQ (CAR TERM1)
(CAR TERM2))
(ONE-WAY-UNIFY1-LST (CDR TERM1)
(CDR TERM2)))
(T NIL)))
(DEFUN ONE-WAY-UNIFY1-LST (LST1 LST2)
(COND ((NULL LST1)
T)
((ONE-WAY-UNIFY1 (CAR LST1)
(CAR LST2))
(ONE-WAY-UNIFY1-LST (CDR LST1)
(CDR LST2)))
(T NIL)))
(DEFUN REWRITE (TERM)
(COND ((ATOM TERM)
TERM)
(T (REWRITE-WITH-LEMMAS (CONS (CAR TERM)
(REWRITE-ARGS (CDR TERM)))
(GET (CAR TERM)
(QUOTE LEMMAS))))))
(DEFUN REWRITE-ARGS (LST)
(COND ((NULL LST)
NIL)
(T (CONS (REWRITE (CAR LST))
(REWRITE-ARGS (CDR LST))))))
(DEFUN REWRITE-WITH-LEMMAS (TERM LST)
(COND ((NULL LST)
TERM)
((ONE-WAY-UNIFY TERM (CADR (CAR LST)))
(REWRITE (APPLY-SUBST UNIFY-SUBST (CADDR (CAR LST)))))
(T (REWRITE-WITH-LEMMAS TERM (CDR LST)))))
(DEFUN
SETUP NIL
(ADD-LEMMA-LST
(QUOTE ((EQUAL (COMPILE FORM)
(REVERSE (CODEGEN (OPTIMIZE FORM)
(NIL))))
(EQUAL (EQP X Y)
(EQUAL (FIX X)
(FIX Y)))
(EQUAL (GREATERP X Y)
(LESSP Y X))
(EQUAL (LESSEQP X Y)
(NOT (LESSP Y X)))
(EQUAL (GREATEREQP X Y)
(NOT (LESSP X Y)))
(EQUAL (BOOLEAN X)
(OR (EQUAL X (T))
(EQUAL X (F))))
(EQUAL (IFF X Y)
(AND (IMPLIES X Y)
(IMPLIES Y X)))
(EQUAL (EVEN1 X)
(IF (ZEROP X)
(T)
(ODD (SUB1 X))))
(EQUAL (COUNTPS- L PRED)
(COUNTPS-LOOP L PRED (ZERO)))
(EQUAL (FACT- I)
(FACT-LOOP I 1))
(EQUAL (REVERSE- X)
(REVERSE-LOOP X (NIL)))
(EQUAL (DIVIDES X Y)
(ZEROP (REMAINDER Y X)))
(EQUAL (ASSUME-TRUE VAR ALIST)
(CONS (CONS VAR (T))
ALIST))
(EQUAL (ASSUME-FALSE VAR ALIST)
(CONS (CONS VAR (F))
ALIST))
(EQUAL (TAUTOLOGY-CHECKER X)
(TAUTOLOGYP (NORMALIZE X)
(NIL)))
(EQUAL (FALSIFY X)
(FALSIFY1 (NORMALIZE X)
(NIL)))
(EQUAL (PRIME X)
(AND (NOT (ZEROP X))
(NOT (EQUAL X (ADD1 (ZERO))))
(PRIME1 X (SUB1 X))))
(EQUAL (AND P Q)
(IF P (IF Q (T)
(F))
(F)))
(EQUAL (OR P Q)
(IF P (T)
(IF Q (T)
(F))
(F)))
(EQUAL (NOT P)
(IF P (F)
(T)))
(EQUAL (IMPLIES P Q)
(IF P (IF Q (T)
(F))
(T)))
(EQUAL (FIX X)
(IF (NUMBERP X)
X
(ZERO)))
(EQUAL (IF (IF A B C)
D E)
(IF A (IF B D E)
(IF C D E)))
(EQUAL (ZEROP X)
(OR (EQUAL X (ZERO))
(NOT (NUMBERP X))))
(EQUAL (PLUS (PLUS X Y)
Z)
(PLUS X (PLUS Y Z)))
(EQUAL (EQUAL (PLUS A B)
(ZERO))
(AND (ZEROP A)
(ZEROP B)))
(EQUAL (DIFFERENCE X X)
(ZERO))
(EQUAL (EQUAL (PLUS A B)
(PLUS A C))
(EQUAL (FIX B)
(FIX C)))
(EQUAL (EQUAL (ZERO)
(DIFFERENCE X Y))
(NOT (LESSP Y X)))
(EQUAL (EQUAL X (DIFFERENCE X Y))
(AND (NUMBERP X)
(OR (EQUAL X (ZERO))
(ZEROP Y))))
(EQUAL (MEANING (PLUS-TREE (APPEND X Y))
A)
(PLUS (MEANING (PLUS-TREE X)
A)
(MEANING (PLUS-TREE Y)
A)))
(EQUAL (MEANING (PLUS-TREE (PLUS-FRINGE X))
A)
(FIX (MEANING X A)))
(EQUAL (APPEND (APPEND X Y)
Z)
(APPEND X (APPEND Y Z)))
(EQUAL (REVERSE (APPEND A B))
(APPEND (REVERSE B)
(REVERSE A)))
(EQUAL (TIMES X (PLUS Y Z))
(PLUS (TIMES X Y)
(TIMES X Z)))
(EQUAL (TIMES (TIMES X Y)
Z)
(TIMES X (TIMES Y Z)))
(EQUAL (EQUAL (TIMES X Y)
(ZERO))
(OR (ZEROP X)
(ZEROP Y)))
(EQUAL (EXEC (APPEND X Y)
PDS ENVRN)
(EXEC Y (EXEC X PDS ENVRN)
ENVRN))
(EQUAL (MC-FLATTEN X Y)
(APPEND (FLATTEN X)
Y))
(EQUAL (MEMBER X (APPEND A B))
(OR (MEMBER X A)
(MEMBER X B)))
(EQUAL (MEMBER X (REVERSE Y))
(MEMBER X Y))
(EQUAL (LENGTH (REVERSE X))
(LENGTH X))
(EQUAL (MEMBER A (INTERSECT B C))
(AND (MEMBER A B)
(MEMBER A C)))
(EQUAL (NTH (ZERO)
I)
(ZERO))
(EQUAL (EXP I (PLUS J K))
(TIMES (EXP I J)
(EXP I K)))
(EQUAL (EXP I (TIMES J K))
(EXP (EXP I J)
K))
(EQUAL (REVERSE-LOOP X Y)
(APPEND (REVERSE X)
Y))
(EQUAL (REVERSE-LOOP X (NIL))
(REVERSE X))
(EQUAL (COUNT-LIST Z (SORT-LP X Y))
(PLUS (COUNT-LIST Z X)
(COUNT-LIST Z Y)))
(EQUAL (EQUAL (APPEND A B)
(APPEND A C))
(EQUAL B C))
(EQUAL (PLUS (REMAINDER X Y)
(TIMES Y (QUOTIENT X Y)))
(FIX X))
(EQUAL (POWER-EVAL (BIG-PLUS1 L I BASE)
BASE)
(PLUS (POWER-EVAL L BASE)
I))
(EQUAL (POWER-EVAL (BIG-PLUS X Y I BASE)
BASE)
(PLUS I (PLUS (POWER-EVAL X BASE)
(POWER-EVAL Y BASE))))
(EQUAL (REMAINDER Y 1)
(ZERO))
(EQUAL (LESSP (REMAINDER X Y)
Y)
(NOT (ZEROP Y)))
(EQUAL (REMAINDER X X)
(ZERO))
(EQUAL (LESSP (QUOTIENT I J)
I)
(AND (NOT (ZEROP I))
(OR (ZEROP J)
(NOT (EQUAL J 1)))))
(EQUAL (LESSP (REMAINDER X Y)
X)
(AND (NOT (ZEROP Y))
(NOT (ZEROP X))
(NOT (LESSP X Y))))
(EQUAL (POWER-EVAL (POWER-REP I BASE)
BASE)
(FIX I))
(EQUAL (POWER-EVAL (BIG-PLUS (POWER-REP I BASE)
(POWER-REP J BASE)
(ZERO)
BASE)
BASE)
(PLUS I J))
(EQUAL (GCD X Y)
(GCD Y X))
(EQUAL (NTH (APPEND A B)
I)
(APPEND (NTH A I)
(NTH B (DIFFERENCE I (LENGTH A)))))
(EQUAL (DIFFERENCE (PLUS X Y)
X)
(FIX Y))
(EQUAL (DIFFERENCE (PLUS Y X)
X)
(FIX Y))
(EQUAL (DIFFERENCE (PLUS X Y)
(PLUS X Z))
(DIFFERENCE Y Z))
(EQUAL (TIMES X (DIFFERENCE C W))
(DIFFERENCE (TIMES C X)
(TIMES W X)))
(EQUAL (REMAINDER (TIMES X Z)
Z)
(ZERO))
(EQUAL (DIFFERENCE (PLUS B (PLUS A C))
A)
(PLUS B C))
(EQUAL (DIFFERENCE (ADD1 (PLUS Y Z))
Z)
(ADD1 Y))
(EQUAL (LESSP (PLUS X Y)
(PLUS X Z))
(LESSP Y Z))
(EQUAL (LESSP (TIMES X Z)
(TIMES Y Z))
(AND (NOT (ZEROP Z))
(LESSP X Y)))
(EQUAL (LESSP Y (PLUS X Y))
(NOT (ZEROP X)))
(EQUAL (GCD (TIMES X Z)
(TIMES Y Z))
(TIMES Z (GCD X Y)))
(EQUAL (VALUE (NORMALIZE X)
A)
(VALUE X A))
(EQUAL (EQUAL (FLATTEN X)
(CONS Y (NIL)))
(AND (NLISTP X)
(EQUAL X Y)))
(EQUAL (LISTP (GOPHER X))
(LISTP X))
(EQUAL (SAMEFRINGE X Y)
(EQUAL (FLATTEN X)
(FLATTEN Y)))
(EQUAL (EQUAL (GREATEST-FACTOR X Y)
(ZERO))
(AND (OR (ZEROP Y)
(EQUAL Y 1))
(EQUAL X (ZERO))))
(EQUAL (EQUAL (GREATEST-FACTOR X Y)
1)
(EQUAL X 1))
(EQUAL (NUMBERP (GREATEST-FACTOR X Y))
(NOT (AND (OR (ZEROP Y)
(EQUAL Y 1))
(NOT (NUMBERP X)))))
(EQUAL (TIMES-LIST (APPEND X Y))
(TIMES (TIMES-LIST X)
(TIMES-LIST Y)))
(EQUAL (PRIME-LIST (APPEND X Y))
(AND (PRIME-LIST X)
(PRIME-LIST Y)))
(EQUAL (EQUAL Z (TIMES W Z))
(AND (NUMBERP Z)
(OR (EQUAL Z (ZERO))
(EQUAL W 1))))
(EQUAL (GREATEREQPR X Y)
(NOT (LESSP X Y)))
(EQUAL (EQUAL X (TIMES X Y))
(OR (EQUAL X (ZERO))
(AND (NUMBERP X)
(EQUAL Y 1))))
(EQUAL (REMAINDER (TIMES Y X)
Y)
(ZERO))
(EQUAL (EQUAL (TIMES A B)
1)
(AND (NOT (EQUAL A (ZERO)))
(NOT (EQUAL B (ZERO)))
(NUMBERP A)
(NUMBERP B)
(EQUAL (SUB1 A)
(ZERO))
(EQUAL (SUB1 B)
(ZERO))))
(EQUAL (LESSP (LENGTH (DELETE X L))
(LENGTH L))
(MEMBER X L))
(EQUAL (SORT2 (DELETE X L))
(DELETE X (SORT2 L)))
(EQUAL (DSORT X)
(SORT2 X))
(EQUAL (LENGTH (CONS X1
(CONS X2
(CONS X3 (CONS X4
(CONS X5
(CONS X6 X7)))))))
(PLUS 6 (LENGTH X7)))
(EQUAL (DIFFERENCE (ADD1 (ADD1 X))
2)
(FIX X))
(EQUAL (QUOTIENT (PLUS X (PLUS X Y))
2)
(PLUS X (QUOTIENT Y 2)))
(EQUAL (SIGMA (ZERO)
I)
(QUOTIENT (TIMES I (ADD1 I))
2))
(EQUAL (PLUS X (ADD1 Y))
(IF (NUMBERP Y)
(ADD1 (PLUS X Y))
(ADD1 X)))
(EQUAL (EQUAL (DIFFERENCE X Y)
(DIFFERENCE Z Y))
(IF (LESSP X Y)
(NOT (LESSP Y Z))
(IF (LESSP Z Y)
(NOT (LESSP Y X))
(EQUAL (FIX X)
(FIX Z)))))
(EQUAL (MEANING (PLUS-TREE (DELETE X Y))
A)
(IF (MEMBER X Y)
(DIFFERENCE (MEANING (PLUS-TREE Y)
A)
(MEANING X A))
(MEANING (PLUS-TREE Y)
A)))
(EQUAL (TIMES X (ADD1 Y))
(IF (NUMBERP Y)
(PLUS X (TIMES X Y))
(FIX X)))
(EQUAL (NTH (NIL)
I)
(IF (ZEROP I)
(NIL)
(ZERO)))
(EQUAL (LAST (APPEND A B))
(IF (LISTP B)
(LAST B)
(IF (LISTP A)
(CONS (CAR (LAST A))
B)
B)))
(EQUAL (EQUAL (LESSP X Y)
Z)
(IF (LESSP X Y)
(EQUAL T Z)
(EQUAL F Z)))
(EQUAL (ASSIGNMENT X (APPEND A B))
(IF (ASSIGNEDP X A)
(ASSIGNMENT X A)
(ASSIGNMENT X B)))
(EQUAL (CAR (GOPHER X))
(IF (LISTP X)
(CAR (FLATTEN X))
(ZERO)))
(EQUAL (FLATTEN (CDR (GOPHER X)))
(IF (LISTP X)
(CDR (FLATTEN X))
(CONS (ZERO)
(NIL))))
(EQUAL (QUOTIENT (TIMES Y X)
Y)
(IF (ZEROP Y)
(ZERO)
(FIX X)))
(EQUAL (GET J (SET I VAL MEM))
(IF (EQP J I)
VAL
(GET J MEM)))))))
(DEFUN TAUTOLOGYP (X TRUE-LST FALSE-LST)
(COND ((TRUEP X TRUE-LST)
T)
((FALSEP X FALSE-LST)
NIL)
((ATOM X)
NIL)
((EQ (CAR X)
(QUOTE IF))
(COND ((TRUEP (CADR X)
TRUE-LST)
(TAUTOLOGYP (CADDR X)
TRUE-LST FALSE-LST))
((FALSEP (CADR X)
FALSE-LST)
(TAUTOLOGYP (CADDDR X)
TRUE-LST FALSE-LST))
(T (AND (TAUTOLOGYP (CADDR X)
(CONS (CADR X)
TRUE-LST)
FALSE-LST)
(TAUTOLOGYP (CADDDR X)
TRUE-LST
(CONS (CADR X)
FALSE-LST))))))
(T NIL)))
(DEFUN TAUTP (X)
(TAUTOLOGYP (REWRITE X)
NIL NIL))
(DEFUN TEST NIL
(PROG (ANS TERM)
(SETQ TERM
(APPLY-SUBST
(QUOTE ((X F (PLUS (PLUS A B)
(PLUS C (ZERO))))
(Y F (TIMES (TIMES A B)
(PLUS C D)))
(Z F (REVERSE (APPEND (APPEND A B)
(NIL))))
(U EQUAL (PLUS A B)
(DIFFERENCE X Y))
(W LESSP (REMAINDER A B)
(MEMBER A (LENGTH B)))))
(QUOTE (IMPLIES (AND (IMPLIES X Y)
(AND (IMPLIES Y Z)
(AND (IMPLIES Z U)
(IMPLIES U W))))
(IMPLIES X W)))))
(SETQ ANS (TAUTP TERM))))
(DEFUN TRANS-OF-IMPLIES (N)
(LIST (QUOTE IMPLIES)
(TRANS-OF-IMPLIES1 N)
(LIST (QUOTE IMPLIES)
0 N)))
(DEFUN TRANS-OF-IMPLIES1 (N)
(COND ((EQUAL N 1)
(LIST (QUOTE IMPLIES)
0 1))
(T (LIST (QUOTE AND)
(LIST (QUOTE IMPLIES)
(SUB1 N)
N)
(TRANS-OF-IMPLIES1 (SUB1 N))))))
(DEFUN TRUEP (X LST)
(OR (EQUAL X (QUOTE (T)))
(MEMBER X LST)))
(INCLUDE "TIMER.LSP")
(TIMER TIMIT (TEST))
(SETUP)
;;;END
;;;BEGIN
;;;STAK
(declare
(fixnum (tak fixnum fixnum fixnum))
(fixnum (stak))
(special x y z)
(fixnum x y z))
(defun tak (x y z)
(stak))
(defun stak ()
(cond ((not (< y x)) ;x≤y
z)
(t (let ((x (let ((x (1- x))
(y y)
(z z))
(stak)))
(y (let ((x (1- y))
(y z)
(z x))
(stak)))
(z (let ((x (1- z))
(y x)
(z y))
(stak))))
(stak)))))
(include "timer.lsp")
(timer timit (tak 18. 12. 6.))
;;;END
;;;BEGIN
;;;CTAK
(declare
(fixnum (tak fixnum fixnum fixnum)))
(defun tak (x y z)
(*catch 'tak (tak1 x y z)))
(defun tak1 (x y z)
(cond ((not (< y x)) ;x≤y
(*throw 'tak z))
(t (tak1
(*catch 'tak
(tak1 (1- x)
y
z))
(*catch 'tak
(tak1 (1- y)
z
x))
(*catch 'tak
(tak1 (1- z)
x
y))))))
(include "timer.lsp")
(timer timit (tak 18. 12. 6.))
;;;END
;;;BEGIN
;;; THE FILE "TIMER.LSP"
(declare (setq defmacro-for-compiling ()) (*expr ttime dtime loadav))
;;; date and time processing
(defmacro pp-time ()
`(let ((time (status daytime)))
(implode (append (pp-two-digits (car time))
'(|:|)
(pp-two-digits (cadr time))
'(|:|)
(pp-two-digits (caddr time))))))
(defmacro pp-date ()
'(let ((date (status date))
(dow (exploden (status dow))))
(implode (append (pp-process-dow dow)
'(| |)
(pp-two-digits (cadr date))
'(|//|)
(pp-two-digits (caddr date))
'(|//|)
(pp-two-digits (car date))))))
(defmacro pp-two-digits (n)
`((lambda (n)
(declare (fixnum n))
(list (+ (car (exploden '|0|)) (quotient n 10.))
(+ (car (exploden '|0|)) (remainder n 10.))))
,n))
(defmacro pp-process-dow (dow)
`(let ((dow ,dow))
(cons (car dow)
(do ((chars (cdr dow) (cdr chars))
(newchars () (cons (+ diff (car chars)) newchars))
(diff (- (car (exploden '|a|))
(car (exploden '|A|)))))
((null chars)
(nreverse newchars))))))
(defmacro timer (name form . args)
`(defun ,name ,args
(terpri)
(princ "Timing performed on ")
(princ (pp-date))
(princ " at ")
(princ (pp-time))
(princ".")
((lambda (t1 t2 t3 gt lb la)
,form
(setq t1 (- (runtime) t1)
t2 (- (dtime) t2)
t3 (- (ttime) t3)
gt (- (status gctime) gt)
la (loadav))
(terpri)
(princ "Cpu (- GC) Time = ")
(princ (//$ (FLOAT (- t1 gt))
1000000.0))
(terpri)
(princ "Elapsed Time = ")
(princ (//$ (float t2) 60.0))
(terpri)
(princ "Wholine Time = ")
(princ (//$ (float t3) 60.0))
(terpri)
(princ "GC Time = ")
(princ (//$ (float gt) 1000000.0))
(terpri)
(princ "Load Average Before = ")
(princ lb)
(terpri)
(princ "Load Average After = ")
(princ la)(terpri)
(princ "Average Load Average = ")
(princ (//$ (+$ la lb) 2.0))(terpri))
(runtime) (dtime)(ttime)(status gctime)(loadav) 0)))
(*rset (nouuo ()))
;;;THE FILE "TTIME.LAP[MAC,LSP]
;;; Return the total wholine time
(lap ttime subr)
(args ttime (nil . 0))
(defsym ttime #o214) ;where wholine time is
(defsym fltr 127←26.)
(calli t 30) ;gets jobnum in tt
(movei tt ttime)
(calli tt 33) ;get that table
(add tt t) ;add jobnum
(calli tt 33)
(jrst 0 fix1) ;return fixnum
()
(lap dtime subr)
(args dtime (nil . 0))
(calli tt 22)
(jrst 0 fix1)
()
(lap loadav subr)
(args loadav (nil . 0))
(movei tt #o331)
(calli tt 33)
(hlrz d tt)
(idivi d #o1000)
(add d (+ d 1))
(movei r 1)
(lsh r 0 d)
(hrrzs 0 tt)
(calli tt 33)
(127←27. tt tt)
(127←27. r r)
(fdv tt r)
(jrst 0 float1)
()
;;;THE REAL END